home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / ti / pcscm3_3 / pkdisk2.arc / GRAPHICS.S < prev    next >
Encoding:
Text File  |  1988-06-07  |  1.8 KB  |  58 lines
  1. (define-integrable setp
  2.   (lambda (x y color xor)
  3.     (%graphics 1 x y color 0 0 xor)))
  4. (define-integrable resetp
  5.   (lambda (cc nc)
  6.     (%graphics 2 cc nc 0 0 0 0)))
  7. (define-integrable line
  8.   (lambda (x1 y1 x2 y2 color xor)
  9.     (%graphics 3 x1 y1 x2 y2 color xor)))
  10. (define-integrable point
  11.   (lambda (x y)
  12.     (%graphics 4 x y 0 0 0 0)))
  13. (define-integrable draw-box
  14.   (lambda (x1 y1 x2 y2 color xor)
  15.     (%graphics 6 x1 y1 x2 y2 color xor)))
  16. (define-integrable draw-filled-box
  17.   (lambda (x1 y1 x2 y2 color xor)
  18.     (%graphics 7 x1 y1 x2 y2 color xor)))
  19. (define-integrable clipping-rectangle
  20.   (lambda (x1 y1 x2 y2)
  21.     (%graphics 8 x1 y1 x2 y2 0 0)))
  22. ;
  23. ; x and y are coordinates of upper left corner of picture
  24. ; a and b are coordinates of upper left corner of clipping rectangle
  25. ; c and d are coordinates of lower right corner of clipping rectangle
  26. ;
  27. (define cga-example
  28.   (lambda (x y a b c d)
  29.     ; set video mode to graphics
  30.     (set-video-mode! 4)
  31.     (ti-example x y a b c d)
  32.     (display "Type a key to return to mode 3")
  33.     (read-char 'console)
  34.     ; return to text mode
  35.     (set-video-mode! 3)))
  36. (define ega-example
  37.   (lambda (x y a b c d)
  38.     ; set video mode to graphics
  39.     (set-video-mode! 16)
  40.     (ti-example x y a b c d)))
  41. (define ti-example
  42.   (lambda (x y a b c d)
  43.     (clear-graphics)
  44.     ; set clipping rectangle
  45.     (clipping-rectangle a b c d)
  46.     ; draw box (replace)
  47.     (draw-box (+ x 10) (+ y 20) (+ x 50) (+ y 50) 3 0)
  48.     ; draw filled box (exclusive or)
  49.     (draw-filled-box (+ x 30) (+ y 30) (+ x 90) (+ y 120) 2 1)
  50.     ; draw line (exclusive or)
  51.     (line (+ x 10) (+ y 20) (+ x 90) (+ y 120) 1 1)
  52.     ; set point
  53.     (setp (+ x 20) (+ y 20) 2 0)
  54.     ; set palette
  55.     (resetp 2 6)
  56.     ; read color of point
  57.     (point (+ x 20) (+ y 20))))
  58.